home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / littlest / littl-st.lha / stdwin.st < prev    next >
Text File  |  1993-08-10  |  10KB  |  451 lines
  1. Class StandardWindows Object
  2. Class Window Object number title menus size
  3. Class   TextWindow Window text
  4. Class   GraphicsWindow Window
  5. Class      DictionaryWindow GraphicsWindow dict select action
  6. Class         BrowserWindow DictionaryWindow class method mw tw
  7. Class EventManager Process responses
  8. Class Menu Object number title itemtitles items enablestatus
  9. Methods Window 'all'
  10.     new
  11.         title <- ''.
  12.         menus <- List new.
  13.         (1 to: 15) do: [:i | (windows at: i) isNil
  14.             ifTrue: [ windows at: i put: self.
  15.                     number <- i.  ^ self ] ]
  16. |
  17.     attachMenu: menu
  18.         menus addLast: menu.
  19.         <162 number 2 (menu number)>
  20. |
  21.     activate
  22.         ^ nil
  23. |
  24.     deactivate
  25.         ^ nil
  26. |
  27.     drawEvent
  28.         " overridden in subclasses "
  29.         ^ nil
  30. |
  31.     mouseMoveTo: mouseLocation
  32.         " mouse moved with button down "
  33.         ^ nil
  34. |
  35.     mouseDownAt: mouseLocation
  36.         " mouse down, do nothing "
  37.         ^ nil
  38. |
  39.     mouseUpAt: mouseLocation
  40.         " mouse up "
  41.         ^ nil
  42. |
  43.     command: n
  44.         (n = 1) ifTrue: [ self close ]
  45. |
  46.     reSized
  47.         size <- <161 number 6>
  48. |
  49.     open
  50.         " open our window, unless already opened "
  51.         <160 number title 0>.
  52.         menus do: [:m | <162 number 2 (m number)> ].
  53.         self reSized.
  54. |
  55.     charTyped: c
  56.         smalltalk beep
  57. |
  58.     title: text
  59.         title <- text.
  60.         <164 number title>
  61. |
  62.     close
  63.         " close up shop "
  64.         <161 number 1>.
  65.         windows at: number put: nil
  66. ]
  67. Methods TextWindow 'all'
  68.     open
  69.         "open the window with implicit text buffer"
  70.         <160 number title 1>.
  71.         " now do other initialization "
  72.         super open
  73. |
  74.     activate
  75.         super activate.
  76.         printer <- self.
  77. |
  78.     deactivate
  79.         super deactivate.
  80.         printer <- stdout.
  81. |
  82.     text
  83.         " read updated text and store it"
  84.         ^ text <- <165 number>
  85. |
  86.     print: text
  87.         <166 number text>
  88. |
  89.     draw
  90.         "redraw window"
  91.         <161 number 2>.
  92.         <161 number 5>.
  93.         <161 number 3>
  94. ]
  95. Methods GraphicsWindow 'all'
  96.     startDrawing
  97.         <161 number 2>
  98. |
  99.     endDrawing
  100.         <161 number 3>
  101. |
  102.     drawEvent
  103.         self startDrawing.
  104.         self draw.
  105.         self endDrawing.
  106. |
  107.     draw
  108.         " done by subclasses "
  109.         ^ nil
  110. |
  111.     at: x and: y print: text
  112.         <190 x y text>
  113. ]
  114. Methods DictionaryWindow 'all'
  115.     action: aBlock
  116.         action <- aBlock
  117. |
  118.     dictionary: d
  119.         dict <- d.
  120.         <163 number 2 40 (12* d size)>
  121. |
  122.     draw        | loc |
  123.         select notNil
  124.             ifTrue: [ select erase ].
  125.         loc <- 0.
  126.         dict binaryDo: [:x :y |
  127.             self at: 0 and: loc print: x asString.
  128.             loc <- loc + 12 ].
  129.         <163 number 2 40 loc >.
  130.         select notNil
  131.             ifTrue: [ select invert ].
  132. |
  133.     mouseDownAt: mouseLocation    | y loc |
  134.         self invertSelection.
  135.         y <- mouseLocation y.
  136.         loc <- 0.
  137.         dict binaryDo: [:a :b |
  138.             loc <- loc + 12.
  139.             (loc > y) ifTrue: [ 
  140.                 select <- 0@(loc - 10) to: size x@loc.
  141.                 self invertSelection. 
  142.                 action value: b. ^ nil ]]
  143. |
  144.     invertSelection
  145.         self startDrawing.
  146.         (select notNil)
  147.             ifTrue: [ select invert ].
  148.         self endDrawing.
  149. ]
  150. Methods BrowserWindow 'all'
  151.     new
  152.         super new.
  153.         dict <- classes.
  154.         action <- [:c | self selectClass: c ].
  155.         self makeBrowserMenu.
  156. |
  157.     close
  158.         " close all our windows "
  159.         tw notNil ifTrue: [ tw close ].
  160.         mw notNil ifTrue: [ mw close ].
  161.         super close.
  162. |
  163.     selectClass: c
  164.         class <- c.
  165.         browserMenu enableItem: 2.
  166.         browserMenu disableItem: 3.
  167.         browserMenu disableItem: 4.
  168.         tw notNil ifTrue: [ tw close ].
  169.         mw notNil ifTrue: [ mw close ].
  170.         self openMethodWindow
  171. |
  172.     openMethodWindow
  173.         tw notNil ifTrue: [ tw close ].
  174.         browserMenu disableItem: 3.
  175.         mw notNil ifTrue: [ mw close ].
  176.         browserMenu enableItem: 2.
  177.         mw <- DictionaryWindow new; 
  178.             title: class printString,  ' Methods';
  179.             dictionary: class methods;
  180.             action: [:c | self selectMethod: c ];
  181.             attachMenu: browserMenu;
  182.             open.
  183. |
  184.     selectMethod: m
  185.         method <- m.
  186.         tw notNil ifTrue: [ tw close ].
  187.         tw <- TextWindow new; 
  188.             title: class printString , ' ', m asString;
  189.             attachMenu: browserMenu;
  190.             open.
  191.         browserMenu enableItem: 3.
  192.         tw print: m text
  193. |
  194.     makeBrowserMenu
  195.         browserMenu isNil ifTrue: 
  196.             [ browserMenu <- Menu new; title: 'Browser'; create.
  197.             browserMenu addItem: 'add class'
  198.                 action: [:w | self addClass ].
  199.             browserMenu addItem: 'add method'
  200.                 action: [:w | self addMethod ].
  201.             browserMenu addItem: 'compile'
  202.                 action: [:w | self compile ].
  203.             browserMenu addItem: 'command'
  204.                 action: [:w | self doCommand ] ].
  205.         browserMenu disableItem: 2.
  206.         browserMenu disableItem: 3.
  207.         browserMenu disableItem: 4.
  208.         self attachMenu: browserMenu
  209. |
  210.     addClass    
  211.         " add a new class "
  212.         tw notNil ifTrue: [ tw close ].
  213.         browserMenu enableItem: 4.
  214.         tw <- TextWindow new; title: 'New Class Information';
  215.             open; attachMenu: browserMenu;
  216.             print: 'superClass addSubClass: #nameOfClass ',
  217.                 'instanceVariableNames: ''var1 var2'' '
  218. |
  219.     addMethod
  220.         method <- Method new.
  221.         tw notNil ifTrue: [ tw close ].
  222.         tw <- TextWindow new; 
  223.             title: class printString , ' new method'.
  224.         tw open; attachMenu: browserMenu.
  225.         browserMenu enableItem: 3.
  226. |
  227.     compile
  228.         method text: tw text.
  229.         (method compileWithClass: class)
  230.             ifTrue: [ class methods at: method name put: method.
  231.                 mw drawEvent ].
  232. |
  233.     doCommand
  234.         " accept tw command "
  235.         [ tw text execute. tw close. self drawEvent ] fork.
  236. ]
  237. Methods Menu 'all'
  238.     new
  239.         items <- Array new: 0.
  240.         itemtitles <- Array new: 0.
  241.         enablestatus <- Array new: 0.
  242.         (1 to: 15) do: [:i | (menus at: i) isNil
  243.             ifTrue: [ menus at: i put: self.
  244.                     number <- i.  ^ self ] ]
  245. |
  246.     number
  247.         ^ number
  248. |
  249.     addItem: name action: aBlock
  250.         items <- items with: aBlock.
  251.         itemtitles <- itemtitles with: name.
  252.         enablestatus <- enablestatus with: true.
  253.         <181 number name nil>
  254. |
  255.     enableItem: n
  256.         enablestatus at: n put: true.
  257.         <182 number n 1 1>
  258. |
  259.     disableItem: n
  260.         enablestatus at: n put: false.
  261.         <182 number n 1 0>
  262. |
  263.     selectItem: n inWindow: w
  264.         " execute the selected menu item "
  265.         (items at: n) value: w
  266. |
  267.     title: aString
  268.         " give the title to a menu item"
  269.         title <- aString
  270. |
  271.     create
  272.         "create menu"
  273.         <180 number title>.
  274.         " reinstate any old items "
  275.         (1 to: items size) do:
  276.             [:i | <181 number (itemtitles at: i) nil>. 
  277.                 (enablestatus at: i) 
  278.                     ifFalse: [ self disableItem: i]]
  279. ]
  280. Methods EventManager 'all'
  281.     new
  282.         responses <- Array new: 12.
  283.         responses at: 1 put: [:w | w activate ].
  284.         responses at: 2 put: [:w | w charTyped: (Char new; value: <171 4>) ].
  285.         responses at: 3 put: [:w | w command: <171 9> ].
  286.         responses at: 4 put: [:w | w mouseDownAt: self mouseLocation ].
  287.         responses at: 5 put: [:w | w mouseMoveTo: self mouseLocation ].
  288.         responses at: 6 put: [:w | w mouseUpAt: self mouseLocation ].
  289.         responses at: 7 put: [:w | self eventMenu 
  290.             selectItem: self menuItem inWindow: w ].
  291.         responses at: 8 put: [:w | w reSized ].
  292.         responses at: 9 put: [:w | w moved ].
  293.         responses at: 10 put: [:w | w drawEvent ].
  294.         responses at: 11 put: [:w | w timer ].
  295.         responses at: 12 put: [:w | w deactivate ].
  296. |
  297.     eventWindow
  298.         ^ windows at: <171 1>
  299. |
  300.     eventMenu
  301.         ^ menus at: <171 2>
  302. |
  303.     menuItem
  304.         ^ <171 3>
  305. |
  306.     mouseLocation
  307.         " return the current location of the mouse "
  308.         ^ <172 1>
  309. |
  310.     execute        | i |
  311.         " process one event "
  312.         i <- <170>.  (i = 0)
  313.         ifFalse: [ (responses at: i) value: self eventWindow ]
  314. ]
  315. Methods StandardWindows 'all'
  316.     makeSystemMenu
  317.         systemMenu isNil ifTrue:
  318.             [ systemMenu <- Menu new; title: 'System'; create.
  319.             systemMenu addItem: 'browser' 
  320.                 action: [:w | BrowserWindow new; title: 'Browser'; open ].
  321.             systemMenu addItem: 'file in'
  322.                 action: [:w | [ File new; 
  323.                     fileIn: (smalltalk askFile: 'file name:')] fork ].
  324.             systemMenu addItem: 'save image'
  325.                 action: [:w | [ smalltalk saveImage: 
  326.                     (smalltalk askNewFile: 'image file:') ] fork ].
  327.             systemMenu addItem: 'quit'
  328.                 action: [:w | scheduler quit ]
  329.             ]
  330. |
  331.     makeWorkspaceMenu
  332.         workspaceMenu isNil ifTrue: [
  333.             workspaceMenu <- Menu new; title: 'Workspace'; create.
  334.             workspaceMenu addItem: 'print it'
  335.                 action: [:w | [ w print:  w text value asString ] fork ].
  336.             workspaceMenu addItem: 'do it'
  337.                 action: [:w | [ w text execute ] fork ]]
  338. |
  339.     makeWorkspace
  340.         TextWindow new; title: 'Workspace';
  341.             open; attachMenu: systemMenu; attachMenu: workspaceMenu.
  342. ]
  343. *
  344. * initialization code
  345. * this is executed once, by the initial image maker
  346. *
  347. *
  348. Methods Smalltalk 'doit'
  349.     error: aString    | ew |
  350.         " print a message, and remove current process "
  351.         scheduler currentProcess trace.
  352.         <204 aString>.
  353.         scheduler currentProcess terminate
  354. ]
  355. Methods Scheduler 'get commands'
  356.     initialize
  357.         stdwin makeSystemMenu.
  358.         stdwin makeWorkspaceMenu.
  359.         stdwin makeWorkspace.
  360.         eventManager <- EventManager new.
  361.         scheduler addProcess: eventManager
  362. |
  363.     quit
  364.         " all done - really quit "
  365.         " should probably verify first "
  366.         notdone <- false
  367. ]
  368. Methods UndefinedObject 'initial image'
  369.     createGlobals
  370.         " create global variables in initial image "
  371.         true <- True new.
  372.         false <- False new.
  373.         smalltalk <- Smalltalk new.
  374.         files <- Array new: 15.
  375.         stdin <- File new; name: 'stdin'; mode: 'r'; open.
  376.         stdout <- File new; name: 'stdout'; mode: 'w'; open.
  377.         stderr <- File new; name: 'stderr'; mode: 'w'; open.
  378.         printer <- stdout.
  379.         " create a dictionary of classes "
  380.         classes <- Dictionary new.
  381.         symbols binaryDo: [:x :y | 
  382.             (y class == Class)
  383.                 ifTrue: [ classes at: x put: y ] ].
  384.         scheduler <- Scheduler new.
  385.         stdwin <- StandardWindows new.
  386.         windows <- Array new: 15.
  387.         menus <- Array new: 15.
  388.         windows <- Array new: 15.
  389. |
  390.     initialize    | aBlock |
  391.         " initialize the initial object image "
  392.         self createGlobals.
  393.         " create the initial system process "
  394.         " note the delayed recursive call "
  395.         aBlock <- [ files do: [:f | f notNil ifTrue: [ f open ]].
  396.                 menus do: [:m | m notNil ifTrue: [ m create ]].
  397.                 windows do: [:w | w notNil ifTrue: [ w open ]].
  398.                 systemProcess <- aBlock newProcess.
  399.                 scheduler run ].
  400.         systemProcess <- aBlock newProcess.
  401.         File new;
  402.             name: 'systemImage';
  403.             open: 'wb';
  404.             saveImage;
  405.             close.
  406. ]
  407. Methods String 'test'
  408.     print
  409.         ^ printer print: self
  410. ]
  411. Methods Smalltalk 'interface'
  412.     getPrompt: aString
  413.         ^ <201 aString ''>
  414. |
  415.     askNewFile: prompt    | name |
  416.         " ask for a new file name "
  417.         name <- <203 prompt '' 1>.
  418.         ^ name isNil ifTrue: [ '' ] ifFalse: [ name ]
  419. |
  420.     askFile: prompt        | name |
  421.         name <- <203 prompt '' 0>.
  422.         ^ name isNil ifTrue: [ '' ] ifFalse: [ name ]
  423. |
  424.     inquire: aString
  425.         ^ <202 aString 1>
  426. ]
  427. Methods Rectangle 'drawing'
  428.     frame
  429.         <194 1 left top right bottom>
  430. |
  431.     paint
  432.         <194 2 left top right bottom>
  433. |
  434.     erase
  435.         <194 3 left top right bottom>
  436. |
  437.     invert
  438.         <194 4 left top right bottom>
  439. |
  440.     shade: aPercent
  441.         <195 1 left top right bottom aPercent>
  442. ]
  443. Methods Smalltalk 'beep'
  444.     beep
  445.         <205>
  446. ]
  447. Methods Circle 'drawing'
  448.     frame
  449.         <193 1 (center x) (center y) radius>
  450. ]
  451.